{
*******************************************************************************
-------------------------------------------------------------------------------
Kliper - next generation multimedia player
Copyright (C) Marcin 'vi4m' Kliks (vi4m@wp.pl)
Copyright (C) Tomasz 'dymsza' Odrobny (dymsza@gmail.com)
-------------------------------------------------------------------------------
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
*******************************************************************************
}
unit utils;


interface
uses classes, graphics, sysutils, messages, dialogs, inifiles, defaults, types, stdctrls, menus, comctrls;

function isRemote(const filename: string): boolean;
function explode(s: string; delim: string): tstringlist;
procedure StringToFont(sFont: string; var Font: TFont);
function FontToString(Font: TFont): string;
procedure showerror(s: string; param1: string = ''; param2: string = ''; param3: string = '');
procedure showinfo(s: string);
function getLang: string;
function FindFiles(const Path: string; const FileSpec: string): TStringList;
function DelphiExitWindows(Flags: Word): Boolean;
function translatestr(ident: string; param1: string = ''; param2: string = ''; param3: string = ''): string;
function filter(s: string; param1: string = ''; param2: string = ''; param3: string = ''): string;
function getdesktoparea: trect;
function timeit(i: integer): string;
procedure mydumpControls(section: string; t: tcomponent; var x:tinifile);


implementation
uses regexpr, core, strutils, os, windows;
const
  csfsBold = '|Bold';
  csfsItalic = '|Italic';
  csfsUnderline = '|Underline';
  csfsStrikeout = '|Strikeout';
//------------------------------------------------------------------------

//returns list of words separated by delim, from s-string

function explode(s: string; delim: string): tstringlist;
var
  list: tstringlist;
  x: tregexpr;
begin
  x := tregexpr.create;
  try
    list := tstringlist.create;
    x.expression := delim;
    x.split(s, list);
    result := list;
  finally
    x.free;
    //list remains for user - free yourself!
  end;
end;
//------------------------------------------------------------------------

 //check whatever filename is a remote protocol (ie http, mms);

function isRemote(const filename: string): boolean;
const x: array[0..2] of string = ('mms://', 'http://', 'ftp://');
var
  i: integer;
  p: pchar;
  dupa: string;
  fname: pchar;
begin
  getmem(fname, length(filename) + 1);
  strpcopy(fname, filename);
  for i := 0 to length(x) - 1 do begin
    if (ansistrpos(strlower(fname), strlower(pchar(x[i]))) <> nil)
      then begin
      result := true;
      freemem(fname);
      exit;
    end;
  end;
  result := false;
  freemem(fname);

end;


//------------------------------------------------------------------------
//
// Expected format:
//   "Arial", 9, [Bold], [clRed]

procedure StringToFont(
  sFont: string; var Font: TFont);
var
  p: integer;
  sStyle: string;
begin
  with Font do
  begin
    // get font name
    p := system.Pos(',', sFont);
    Name :=
      Copy(sFont, 2, p - 3);
    Delete(sFont, 1, p);

    // get font size
    p := system.Pos(',', sFont);
    Size :=
      StrToInt(Copy(sFont, 2, p - 2));
    Delete(sFont, 1, p);

    // get font style
    p := system.Pos(',', sFont);
    sStyle :=
      '|' + Copy(sFont, 3, p - 4);
    Delete(sFont, 1, p);

    // get font color
    Color :=
      StringToColor(
      Copy(sFont, 3,
      Length(sFont) - 3));

    // convert str font style to
    // font style
    Style := [];

    if (system.Pos(csfsBold,
      sStyle) > 0) then
      Style := Style + [fsBold];

    if (system.Pos(csfsItalic,
      sStyle) > 0) then
      Style := Style + [fsItalic];

    if (system.Pos(csfsUnderline,
      sStyle) > 0) then
      Style := Style + [fsUnderline];

    if (system.Pos(csfsStrikeout,
      sStyle) > 0) then
      Style := Style + [fsStrikeout];
  end;
end;

//-------------------------------------------------------------
// Encode font into the string variable
// Output format:
//   "Arial", 9, [Bold|Italic], [clAqua]
//-------------------------------------------------------------

function FontToString(
  Font: TFont): string;
var
  sStyle: string;
begin
  with Font do
  begin
    // convert font style to string
    sStyle := '';

    if (fsBold in Style) then
      sStyle := sStyle + csfsBold;

    if (fsItalic in Style) then
      sStyle := sStyle + csfsItalic;

    if (fsUnderline in Style) then
      sStyle := sStyle + csfsUnderline;

    if (fsStrikeout in Style) then
      sStyle := sStyle + csfsStrikeout;

    if ((Length(sStyle) > 0) and
      ('|' = sStyle[1])) then
    begin
      sStyle :=
        Copy(sStyle, 2,
        Length(sStyle) - 1);
    end;

    Result := Format(
      '"%s", %d, [%s], [%s]',
      [Name,
      Size,
        sStyle,
        ColorToString(Color)]);
  end;
end;

//------------------------------------------------------------------------

procedure showerror(s: string; param1: string = ''; param2: string = ''; param3: string = '');
begin
  messagedlg(translatestr(s, param1, param2, param3), mtError, [mbOk], 0);
end;
//------------------------------------------------------------------------

procedure showinfo(s: string);
begin
  messagedlg(translatestr(s), mtInformation, [mbOk], 0);
end;

//####################################################################
// async versions
//####################################################################

procedure showinfoa(s: string);
begin
  showasyncmsg(translatestr(s), 1);
end;

procedure showerrora(s: string);
begin
  showasyncmsg(translatestr(s), 0);
end;

//-------------------------------------------------------------
// Returns full string translated to current language
//-------------------------------------------------------------

function translatestr(ident: string; param1: string = ''; param2: string = ''; param3: string = ''): string;
var
  i: tinifile;
  transerr: string;
begin
  i := tinifile.Create(extractFileDir(paramstr(0)) + '\lang\' + getLang);
  transerr := i.ReadString('messages', ident, '(U)#' + ident);
  transerr := filter(transerr, param1, param2, param3);
  result := transerr;
  i.Free;
end;

//-------------------------------------------------------------
//returns current Language read from config.ini.
//It is neccessary, to read lang before creating settingsform
//-------------------------------------------------------------

function getLang: string;
var t: tinifile;
begin
  try
    t := tinifile.create(extractfiledir(paramstr(0)) + '\config.ini');
    result := t.ReadString('main', 'lang', KLIPER_DEFAULT_LANG);
    getLang := result;
  finally
    t.Free;
  end;
end;
//-------------------------------------------------------------

function filter(s: string; param1: string = ''; param2: string = ''; param3: string = ''): string;
begin
  result := ansireplacestr(s, '$VERSION', kliper_version);
  result := ansireplacestr(result, '%1', param1);
  result := ansireplacestr(result, '%2', param2);
  result := ansireplacestr(result, '%3', param3);
  result := ansireplacestr(result, '\n', #13);
end;

//-------------------------------------------------------------

function FindFiles(const Path: string; const FileSpec: string): TStringList;
var
  ReturnCode: INTEGER;
  SearchRec: TSearchRec;
  x: tstringlist;
begin
  x := tstringlist.create;

  ReturnCode := SysUtils.FindFirst(Path + '\' +
    Filespec, faAnyFile, SearchRec);
  try
    while ReturnCode = 0 do
    begin
      if (SearchRec.Attr and faDirectory <> faDirectory) and
        (SearchRec.Name <> '.') and
        (SearchRec.Name <> '..')
        then x.Add(searchrec.Name);
      ReturnCode := SysUtils.FindNext(SearchRec)
    end;
  finally
    SysUtils.FindClose(SearchRec)
  end;
  result := x;
end {CountFiles};

function DelphiExitWindows(Flags: Word): Boolean;
var
  iVersionInfo: TOSVersionInfo;
  iToken: THandle;
  iPriveleg: TTokenPrivileges;
  iaresult: cardinal;
begin

  Result := FALSE;
  FillChar(iPriveleg, SizeOf(iPriveleg), #0);
  iVersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(iVersionInfo);
  if iVersionInfo.dwPlatformId <> VER_PLATFORM_WIN32_NT then
    Result := ExitWindowsEx(Flags, 0)
  else
    if OpenProcessToken(GetCurrentProcess,
      TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, iToken) then
      if LookupPrivilegeValue(nil, 'SeShutdownPrivilege',
        iPriveleg.Privileges[0].Luid) then
      begin
        iPriveleg.PrivilegeCount := 1;
        iPriveleg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
        if AdjustTokenPrivileges(iToken, False, iPriveleg,
          Sizeof(iPriveleg), iPriveleg, iaresult) then
          Result := ExitWindowsEx(Flags, 0);
      end;
end;

//####################################################################

function getdesktoparea: trect;
var
  hApp: HWND;
  rcApp, rcWork: TRect;
begin
  { prepare a default fullscreen workarea }
  rcWork.Top := 0;
  rcWork.Left := 0;
  rcWork.Bottom := GetSystemMetrics(SM_CYSCREEN);
  rcWork.Right := GetSystemMetrics(SM_CXSCREEN);

  { get the taskbar handle }
  hApp := FindWindow('Shell_TrayWnd', '');
  if hApp <> 0 then begin
    { get the size of the taskbar }
    GetWindowRect(hApp, rcApp);
    { cut the workarea to place the taskbar }
    if rcApp.Right < rcWork.Right then
      rcWork.Left := rcApp.Right; { bar on left edge }
    if rcApp.Bottom < rcWork.Bottom then
      rcWork.Top := rcApp.Bottom; { bar on top edge }
    if rcApp.Left > 0 then
      rcWork.Right := rcApp.Left; { bar on right edge }
    if rcApp.Top > 0 then
      rcWork.Bottom := rcApp.Top; { bar on bottom edge }
  end;
  result := rcWork;
end;

function timeit(i: integer): string;
var
  h, m, s: integer;
begin
  h := i div 3600;
  m := i mod 3600 div 60;
  s := i mod 3600 mod 60;
  result := format('%.2d:%.2d:%.2d', [h, m, s]);

end;

procedure mywritestring(x: tinifile; section: string; name: string;
  value: string);
begin
  if not x.valueExists(section, name) then begin
    x.Writestring(section, name, value);
  end;
end;

procedure mydumpControls(section: string; t: tcomponent; var x:
  tinifile);
var
  y: tcomponent;
  i: integer;
begin
  for i := 0 to t.ComponentCount - 1 do begin
    y := t.components[i];
    if (y.ClassNameIs('TButton') or y.ClassNameIs('TBitButton') or
      y.ClassNameIs('TLabel')) then begin
      mywritestring(x, section, y.name, TButton(y).Caption + '#' + Tbutton(y).hint);
    end else if y.ClassNameIs('TMenuItem') then begin
      if length((y as TmenuItem).name) >= 1 then
        mywritestring(x, section, y.name, (y as TMenuItem).Caption);
    end
    else if (y.ClassNameIs('TGroupBox')) then
      mywritestring(x, section, y.name, TGroupBox(y).caption)
    else if (y.classNameis('TCheckBox')) then
      mywritestring(x, section, y.name, TCheckBox(y).caption)
    else if (y.classNameis('TTabSheet')) then
      mywritestring(x, section, y.name, TTabSheet(y).caption)
  end;
end;




end.

